home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctjja86.arc / GRAPH-2D.BAS < prev    next >
BASIC Source File  |  1985-02-06  |  14KB  |  284 lines
  1. 10  ' GRAPH-2D.BAS
  2. 15  '
  3. 20  '             ***************************
  4. 25  '             *         Graph-2D        *
  5. 30  '             *       Version  1.0      *
  6. 35  '             *  (c) F.G. Lether  1985  *
  7. 40  '             ***************************
  8. 45  '
  9. 50  ' This program plots (x,y) points, contained in a
  10. 55  ' sequential data file, on the 640 x 200 pixel high
  11. 60  ' resolution graphics screen of the IBM Personal
  12. 65  ' Computer.
  13. 70  '
  14. 75  ' Initialization
  15. 80      DEFINT I-N : MAXPTS = 500
  16. 85      OPTION BASE 1: DIM X.PTS(500),Y.PTS(500)
  17. 90      CLS : KEY OFF : WIDTH 40
  18. 95      SCREEN 0,1,0,0 : COLOR 7,0,0
  19. 100 ' Display introducrory screen
  20. 105     FOR K = 1 TO 20
  21. 110        LOCATE K + 2,2,0  : PRINT CHR$(176);
  22. 115        LOCATE K + 2,38,0 : PRINT CHR$(176)
  23. 120     NEXT
  24. 125     LOCATE 2,2 : PRINT STRING$(37,176)
  25. 130     LOCATE 23,2 : PRINT STRING$(37,176)
  26. 135     FOR K = 1 TO 6
  27. 140        LOCATE K + 5,10,0  : PRINT CHR$(176);
  28. 145        LOCATE K + 5,30,0 : PRINT CHR$(176)
  29. 150     NEXT
  30. 155     LOCATE 5,10 : PRINT STRING$(21,176)
  31. 160     LOCATE 11,10 : PRINT STRING$(21,176)
  32. 165     COLOR 15
  33. 170     LOCATE 7,17 : PRINT "Graph-2D"
  34. 175     LOCATE 9,15 : PRINT "Version  1.0"
  35. 180     LOCATE 15,7 : PRINT "Copyright  1985 F.G. Lether"
  36. 185     COLOR 0,7
  37. 190     LOCATE 19,9 : PRINT " Press Esc key to quit "
  38. 195     LOCATE 21,6 : PRINT " Press space bar to continue "
  39. 200     COLOR 7,0
  40. 205 ' End if Esc key or continue if space bar pressed
  41. 210     IF INKEY$ <> "" THEN 210
  42. 215     KEYCHR$ = INKEY$ : IF KEYCHR$ = "" THEN 215
  43. 220     IF KEYCHR$ = CHR$(27) THEN CLS : WIDTH 80 : END
  44. 225     IF KEYCHR$ <> CHR$(32) THEN 215
  45. 230 ' Display user input screen
  46. 235     CLS : WIDTH 80
  47. 240     LOCATE 1,37 : PRINT "Graph-2D"
  48. 245     LOCATE 2,37 : PRINT STRING$(8,196)
  49. 250 ' Get user data filename and read data
  50. 255     LOCATE 5,1,0
  51. 260     PRINT "Enter data filename ... ";
  52. 265     MAXLEN = 52 : GOSUB 730 : F$ = STG$
  53. 270     IF LEFT$(F$,1) = " "OR F$ = "" THEN : GOTO 255
  54. 275     IF INSTR(F$,".") = 0 THEN F$ = F$ + ".DAT"
  55. 280     ON ERROR GOTO 595
  56. 285     OPEN F$ FOR INPUT AS #1
  57. 290     LOCATE 25,23
  58. 295     PRINT "Please wait, reading input data ...";
  59. 300     N.PTS = 0
  60. 305     WHILE NOT EOF(1)
  61. 310        N.PTS = N.PTS + 1
  62. 315        IF N.PTS > MAXPTS THEN 335
  63. 320        INPUT #1,X.PTS(N.PTS),Y.PTS(N.PTS)
  64. 325        LOCATE 25,60 : PRINT N.PTS;" points";
  65. 330     WEND
  66. 335     CLOSE #1
  67. 340     SCND = 1! : TICS = 18.2 * SCND : SILENT = 32767
  68. 345     SOUND SILENT,TICS : SOUND SILENT,1
  69. 350     LOCATE 25,23 : PRINT STRING$(49,32);
  70. 355     IF 2 <= N.PTS AND N.PTS < MAXPTS THEN 390
  71. 360        LOCATE 7,1 : SOUND 40,1
  72. 365        PRINT "* Number of points in data file "; 
  73. 370        PRINT "out of range !"
  74. 375        IF N.PTS > MAXPTS THEN PRINT "  Too many points"
  75. 380        IF N.PTS < 2 THEN PRINT "  Less than 2 points"
  76. 385        END
  77. 390     ON ERROR GOTO 0
  78. 395 ' Set default graphics options
  79. 400     TITLE$ = "" : XAXIS$ = "" : YAXIS$ = ""
  80. 405     AXES$ = "Y" : SCL$ = "N" : ANN$ = "Y" : JSIZE = 1
  81. 410 ' Use default graphics options ?
  82. 415     LOCATE 7,1 : PRINT "Graph data using defaults ?";
  83. 420     PRINT "  Enter y or n ... ";
  84. 425     MAXLEN = 1 : GOSUB 730 : ANS$ = STG$
  85. 430     IF ANS$ = "" OR INSTR("YNyn",ANS$) = 0 THEN GOTO 415
  86. 435     IF INSTR("Yy",ANS$) > 0 THEN 565
  87. 440 ' Get user's graphics options from keyboard
  88. 445     LOCATE 9,1 : PRINT "Enter title of graph ... ";
  89. 450     MAXLEN = 52 : GOSUB 730 : TITLE$ = STG$
  90. 455     LOCATE 11,1 : PRINT "Enter horizontal axis name ... ";
  91. 460     MAXLEN = 34 : GOSUB 730 : XAXIS$ = STG$
  92. 465     LOCATE 13,1 : PRINT "Enter vertical axis name ... ";
  93. 470     MAXLEN = 19 : GOSUB 730 : YAXIS$ = STG$
  94. 475     LOCATE 15,1 : PRINT "Draw axes ? Enter y or n ... ";
  95. 480     MAXLEN = 1 : GOSUB 730 : ANS$ = STG$
  96. 485     IF ANS$ = "" OR INSTR("YNyn",ANS$) = 0 THEN GOTO 475
  97. 490     IF INSTR("Yy",ANS$) > 0 THEN AXES$ = "Y"                                                                ELSE AXES$ = "N"
  98. 495     LOCATE 17,1
  99. 500     PRINT "Use uniform scale ? Enter y or n ... ";
  100. 505     MAXLEN = 1 : GOSUB 730 : ANS$ = STG$
  101. 510     IF ANS$ = "" OR INSTR("YNyn",ANS$) = 0 THEN GOTO 495
  102. 515     IF INSTR("Yy",ANS$) > 0 THEN SCL$ = "Y"                                                                 ELSE SCL$ = "N"
  103. 520     LOCATE 19,1
  104. 525     PRINT "Annotate points ? Enter y or n ... ";
  105. 530     MAXLEN = 1 : GOSUB 730 : ANS$ = STG$
  106. 535     IF ANS$ = "" OR INSTR("YNyn",ANS$) = 0 THEN GOTO 520
  107. 540     IF INSTR("Yy",ANS$) > 0 THEN ANN$ = "Y"                                                                 ELSE ANN$ = "N"
  108. 545     IF ANN$ = "N" THEN 565
  109. 550     LOCATE 21,1 : PRINT "Enter annotation size ... ";
  110. 555     MAXLEN = 2 : GOSUB 730 : JSIZE = VAL(STG$)
  111. 560     IF JSIZE < 1 THEN JSIZE = 1
  112. 565     LOCATE 25,24
  113. 570     PRINT "Please wait, determining graph ...";
  114. 575     SOUND SILENT,.5*TICS : SOUND SILENT,1
  115. 580     GOSUB 1330 ' plot data data
  116. 585     GOTO 90
  117. 590 ' Error trapping for input data file
  118. 595     SOUND 40,1 : LOCATE 7,1
  119. 600     PRINT "* Can't obtain input data ";
  120. 605     PRINT "using this filename !"
  121. 610     IF ERR = 71 THEN PRINT "  Disk not ready ."
  122. 615     IF ERR = 53 THEN PRINT "  Data file not found ."
  123. 620     IF ERR = 64 OR ERR = 76 THEN                                                                            PRINT "  Bad data filename ."
  124. 625     PRINT : COLOR 0,7
  125. 630     PRINT " Press space bar to retry ";
  126. 635     PRINT "or press Esc key to stop "
  127. 640     COLOR 7,0 : RESUME 210
  128. 645     ON ERROR GOTO 0
  129. 650     END
  130. 655 ' ----------
  131. 660 ' SUBROUTINE - get keyboard input
  132. 665 ' ----------
  133. 670 ' This subroutine restricts user keyboard input to a
  134. 675 ' horizontal box of specified length, the box starting 
  135. 680 ' at the current position of the cursor. (The code is a  
  136. 685 ' modified version of some techniques suggested by  
  137. 690 ' G. Cuellar for controling user input .)
  138. 695 '
  139. 700 ' Input to this subroutine
  140. 705 '   MAXLEN  length of input box (# characters allowed)
  141. 710 '
  142. 715 ' Output from this subroutine
  143. 720 '   STG$    characters entered in the box from keyboard
  144. 725 '
  145. 730     LOCATE ,,0 : SOUND 40,1
  146. 735     BOX$  = CHR$(29) + CHR$(176) + CHR$(29)
  147. 740     STG$ = ""
  148. 745     DEF FN BCK$(STG$) = LEFT$(STG$,LEN(STG$)-1)
  149. 750     PRINT STRING$(MAXLEN,CHR$(176));
  150. 755     FOR K = 1 TO MAXLEN
  151. 760         PRINT CHR$(29);
  152. 765     NEXT
  153. 770     LOCATE ,,1,7,7 : KEYCHR$ = INPUT$(1)
  154. 775     IF KEYCHR$ = CHR$(8) THEN IF STG$ = "" THEN 770 ELSE                               STG$ = FN BCK$(STG$) : PRINT BOX$; : GOTO 770
  155. 780     IF KEYCHR$ = CHR$(13) THEN                                                                            FOR K = 1 TO MAXLEN - LEN(STG$)                                               : PRINT " "; : NEXT : GOTO 795
  156. 785     IF KEYCHR$ < CHR$(32) OR KEYCHR$ > CHR$(126) THEN 770
  157. 790     IF LEN(STG$) = MAXLEN THEN 770 ELSE PRINT KEYCHR$; :                                     STG$ = STG$ + KEYCHR$ : GOTO 770
  158. 795     LOCATE ,,0
  159. 800     RETURN
  160. 1000 ' ----------
  161. 1010 ' SUBROUTINE - plot data points
  162. 1020 ' ----------
  163. 1030 ' This subroutine plots (x,y) points on the 640 x 200
  164. 1040 ' pixel graphics screen of the IBM PC. It employs the
  165. 1050 ' 432 x 180 pixel, centered viewport (104,10)-(535,189).
  166. 1060 ' This subroutine requires a color graphics adapter
  167. 1070 ' card and BASICA.
  168. 1080 '
  169. 1090 ' Input arguments to this subroutine are as follows :
  170. 1100 '   MAXPTS  the maximum number of (x,y) points allowed
  171. 1110 '   N.PTS   actual number of (x,y)-points to be plotted
  172. 1120 '   X.PTS   array of abscissa x-points to be plotted
  173. 1130 '   Y.PTS   array of ordinate y-points to be plotted
  174. 1140 '   XAXIS$  label for horizontal x-axis (can be blank)
  175. 1150 '   YAXIS$  label for vertical y-axis (can be blank)
  176. 1160 '   TITLE$  title for graph (can be blank)
  177. 1170 '   AXES$   set to "Y" or "y" to plot axes
  178. 1180 '   SCL$    set to "Y" or "y" to use same axis scales
  179. 1190 '   ANN$    set to "Y" or "y" to annotate all points
  180. 1200 '   JSIZE   size of annotation square, e.g. 1,2,3,...
  181. 1210 '
  182. 1220 ' Restrictions for this subroutine are as follows :
  183. 1230 '   MAXPTS should be >= 2, and less than maximum 
  184. 1240 '   number of anticipated points ever to be plotted.
  185. 1250 '   Arrays X.PTS and Y.PTS should be dimensioned to
  186. 1260 '   MAXPTS in the calling code.
  187. 1270 '   N.PTS must satisfy  2 <= N.PTS <= MAXPTS
  188. 1280 '   The respective strings XAXIS$, YAXIS$ and TITLE$
  189. 1290 '   should not consist of more than 34, 19 and 52
  190. 1300 '   characters, respectively.
  191. 1310 '
  192. 1320 ' Compute minimum and maximum of x and y points
  193. 1330     DEF FN BIG(A,B) = B*ABS(A<B) + A*ABS(A>=B)
  194. 1340     DEF FN SMALL(A,B) = B*ABS(A>B) + A*ABS(A<=B)
  195. 1350     X.MIN = X.PTS(1) : X.MAX = X.PTS(1)
  196. 1360     Y.MIN = Y.PTS(1) : Y.MAX = Y.PTS(1)
  197. 1370     FOR K = 2 TO N.PTS
  198. 1380        X.MIN = FN SMALL(X.PTS(K),X.MIN)
  199. 1390        X.MAX = FN BIG(X.PTS(K),X.MAX)
  200. 1400        Y.MIN = FN SMALL(Y.PTS(K),Y.MIN)
  201. 1410        Y.MAX = FN BIG(Y.PTS(K),Y.MAX)
  202. 1420     NEXT
  203. 1430 ' Adjust maximums if uniform scaling 
  204. 1440     IF SCL$ <> "Y" AND SCL$ <> "y" THEN 1470
  205. 1450     IF (X.MAX - X.MIN) > (Y.MAX - Y.MIN) THEN                                          Y.MAX = Y.MIN + (X.MAX - X.MIN) ELSE                                            X.MAX = X.MIN + (Y.MAX - Y.MIN)
  206. 1460 ' Set 432 X 180 pixel viewport (104,10)-(535,189)
  207. 1470     S.ASPECT = 5! / 12!
  208. 1480     Y.PIXELS = 180
  209. 1490     X.PIXELS = CINT(Y.PIXELS / S.ASPECT)
  210. 1500     I.MIN = 104 : I.MAX = I.MIN + X.PIXELS - 1
  211. 1510     J.MIN = 10 : J.MAX = J.MIN + Y.PIXELS - 1
  212. 1520 ' If points annotated with squares, adjust viewport size
  213. 1530     IF ANN$ <> "Y" AND ANN$ <> "y" THEN 1590
  214. 1540        JSIZE = ABS(JSIZE) : JSIZE = FN BIG(JSIZE,1)
  215. 1550        ISIZE = CINT(1! + JSIZE / S.ASPECT)
  216. 1560        I.MIN = I.MIN + ISIZE : I.MAX = I.MAX - ISIZE
  217. 1570        J.MIN = J.MIN + JSIZE : J.MAX = J.MAX - JSIZE
  218. 1580 ' World to physical coordinates transformation
  219. 1590     J.RANGE = J.MAX - J.MIN : Y.RANGE = Y.MAX - Y.MIN
  220. 1600     I.RANGE = I.MAX - I.MIN : X.RANGE = X.MAX - X.MIN
  221. 1610     IF Y.MAX > Y.MIN THEN Y.SCALE = J.RANGE / Y.RANGE
  222. 1620     IF X.MAX > X.MIN THEN X.SCALE = I.RANGE / X.RANGE
  223. 1630     X.ADJ = I.MAX - X.SCALE * X.MAX
  224. 1640     Y.ADJ = J.MAX + Y.SCALE * Y.MIN
  225. 1650 '     Special case of horizontal or vertical line
  226. 1660         IF X.MAX = X.MIN THEN X.SCALE = 0! :                                               X.ADJ = .5 * (I.MAX + I.MIN) :                                                  X.MIN = X.MIN - 1 : X.MAX = X.MAX + 1
  227. 1670         IF Y.MAX = Y.MIN THEN Y.SCALE = 0! :                                               Y.ADJ = .5 * (J.MAX + J.MIN) :                                                  Y.MIN = Y.MIN - 1 : Y.MAX = Y.MAX + 1
  228. 1680     DEF FN I.MAP(X) = CINT(X.SCALE * X + X.ADJ)
  229. 1690     DEF FN J.MAP(Y) = CINT(Y.ADJ - Y.SCALE * Y)
  230. 1700 ' Plot x,y points on high res graphics screen
  231. 1710     SCREEN 2
  232. 1720     IX = FN I.MAP(X.PTS(1)) : JY = FN J.MAP(Y.PTS(1))
  233. 1730     PSET (IX,JY)
  234. 1740     IF ANN$ = "Y" OR ANN$ = "y" THEN                                                   LINE (IX-ISIZE,JY+JSIZE)-(IX+ISIZE,JY-JSIZE),,BF:                               PSET (IX,JY)
  235. 1750     FOR K = 2 TO N.PTS
  236. 1760        IX = FN I.MAP(X.PTS(K)) : JY = FN J.MAP(Y.PTS(K))
  237. 1770        LINE -(IX,JY)
  238. 1780        IF ANN$ = "Y" OR ANN$ = "y" THEN                                                 LINE (IX-ISIZE,JY+JSIZE)-(IX+ISIZE,JY-JSIZE),,BF                                : PSET (IX,JY)
  239. 1790     NEXT
  240. 1800 ' If points annotated, restore original viewport parms
  241. 1810     IF ANN$ = "Y" OR ANN$ = "y" THEN                                                   I.MIN = I.MIN - ISIZE : I.MAX = I.MAX + ISIZE :                                 J.MIN = J.MIN - JSIZE : J.MAX = J.MAX + JSIZE
  242. 1820 ' Draw axes if requested and label axis max and mins
  243. 1830     IF AXES$ <> "Y" AND AXES$ <> "y" THEN 1980
  244. 1840        LINE (I.MIN-2,J.MIN - 1)-(I.MIN-2,J.MAX + 1)
  245. 1850        LINE (I.MAX+2,J.MIN - 1)-(I.MAX+2,J.MAX + 1)
  246. 1860        LINE (I.MIN-2,J.MIN-1)-(I.MAX+2,J.MIN-1)
  247. 1870        LINE (I.MIN-2,J.MAX+1)-(I.MAX+2,J.MAX+1)
  248. 1880        FOR K = I.MIN - 2 TO I.MAX + 2 STEP 2
  249. 1890           PRESET(K,J.MIN-1) : PRESET(K,J.MAX+1)
  250. 1900        NEXT
  251. 1910 ''     LINE (I.MIN-2,J.MIN-1)-(I.MAX+2,J.MIN-1),,,&HAAAA
  252. 1920 ''     LINE (I.MIN-2,J.MAX+1)-(I.MAX+2,J.MAX+1),,,&HAAAA
  253. 1930        LOCATE 2,4 : PRINT USING "##.##^^^^"; Y.MAX ;
  254. 1940        LOCATE 24,4 : PRINT USING "##.##^^^^"; Y.MIN ;
  255. 1950        LOCATE 25,13 : PRINT USING "##.##^^^^"; X.MIN ;
  256. 1960        LOCATE 25,59 : PRINT USING "##.##^^^^"; X.MAX ;
  257. 1970 ' Write graph title (can be blank)
  258. 1980     TTL$ = LEFT$(TITLE$,52)
  259. 1990     LOCATE 1,(41 - LEN(TTL$) / 2) : PRINT TTL$
  260. 2000 ' Write x,y axis labels (can be blank)
  261. 2010     XAX$ = LEFT$(XAXIS$,34)
  262. 2020     LOCATE 25,(41 - LEN(XAX$) / 2) : PRINT XAX$;
  263. 2030     YAX$ = LEFT$(YAXIS$,19)
  264. 2040     FOR K = 1 TO LEN(YAX$)
  265. 2050        LOCATE (12 - LEN(YAX$) / 2) + K , 12
  266. 2060        PRINT MID$(YAX$,K,1);
  267. 2070     NEXT
  268. 2080 ' Display user prompt beside graph for only DELAY seconds
  269. 2090     DEF FN SECONDS = 3600 * VAL(LEFT$(TIME$,2))                                                      + 60 * VAL(MID$(TIME$,4,2))                                                     +      VAL(RIGHT$(TIME$,2))
  270. 2100     DELAY = 1.5 : TIME0 = FN SECONDS
  271. 2110     LOCATE 2,69 : PRINT "************";
  272. 2120     LOCATE 3,69 : PRINT "press key e";
  273. 2130     LOCATE 4,69 : PRINT "to erase the";
  274. 2140     LOCATE 5,69 : PRINT "screen ...";
  275. 2150     LOCATE 6,69 : PRINT "************";
  276. 2160     IF (FN SECONDS - TIME0) < 3 THEN 2160
  277. 2170     FOR K = 0 TO 4
  278. 2180        LOCATE 2 + K,69 : PRINT SPACE$(12);
  279. 2190     NEXT
  280. 2200 ' Wait for E  or e key press to return to calling program
  281. 2210     KEYSYM$ = INKEY$
  282. 2220     IF KEYSYM$ <> "E" AND KEYSYM$ <> "e" THEN 2210 : CLS
  283. 2230     RETURN
  284.